home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / PGM_TOOL / PREVIEW / CLP2DLFI / TF.PRG < prev    next >
Text File  |  1995-10-29  |  4KB  |  187 lines
  1. local ii,jj,kk,line,mii[5],getlist:={},yy
  2. local ff:=0,tt:="test"
  3. static jkj,klkl,xx1[5][6][9]
  4. public pub[10][13]
  5. declare zz[5][10],xx[10][10]    // test for back to back square brackets
  6. declare alleeo[5][10]    && test comment
  7.  
  8. * test pattern
  9.  
  10. && test changing of database commands
  11. ii=fcount()
  12. tt=fieldname(4)
  13. eof()
  14. ? emp->(eof())
  15. ? bof()
  16. emp->(bof())
  17. ? deleted()
  18. emp->(deleted())
  19. emp->(dbdelete())
  20. dbdelete()
  21. ? rlock()
  22. emp->(rlock())
  23. go 55
  24. dbgoto(55)
  25. emp->(dbgoto(55))
  26. emp->(dbdelete())
  27. ? recno()
  28. ii=sample->(recno())
  29. if emp->(lockit()) .and. custnum=partnum
  30.   ii=0
  31. endif
  32. if emp->(lockit(.t.)) .and. custnum=partnum
  33.   ii=0
  34. endif
  35. if emp->(rlock()) .and. custnum=partnum
  36.   ii=0
  37. endif
  38. emp->(unlockit())
  39. append blank
  40. dbappend()
  41. emp->(dbappend())
  42. emp->(dbclosearea())
  43. dbclosearea()
  44. emp->(clozdbf())
  45. skip
  46. skip -1
  47. dbskip(2)
  48. dbskip()
  49. emp->(dbskip())
  50. emp->(dbskip(-1))
  51. lockit()
  52. clozdbf()
  53. unlockit()
  54. seek keychar
  55. dbseek("1011")
  56. seek "1014"
  57. seek descend("1014")
  58. if found()   // is acceptable, however an mxseek() would be better
  59. endif
  60. emp->(dbseek(empnum))
  61. emp->(found())
  62. if !emp->(dbseek(pvar(30))) .and. cust->(dbseek(datehyph(custnum)))
  63. endif
  64. if !emp->(dbseek("001")) .and. cust->(dbseek(custnum))
  65.   emp->name:="tom jackson"
  66.   emp->cust_no:=testpat
  67.   emp->(dbsetorder(1))
  68. endif
  69. set order to 2
  70. set order to tag emp2    && test of set order to tag
  71. set order to tag "emp2"    && test of set order to tag
  72. dbsetorder("emp")    && test of dbsetorder(<tag>)
  73. state->(dbsetorder("emp"))
  74. dbsetorder(1)
  75. state->(dbsetorder(1))
  76. close all
  77. set softseek on
  78.  
  79. && test printer conversions
  80. @ prow(),pcol() say "test pattern"
  81. @ line,pcol() say "test pattern"
  82. @ prow(),5 say "test pattern"
  83. @ prow(),5 say ii pict "99,999.99"
  84. @ 5,0 say"test pattern"
  85. @ 8,5 say ii pict "99,999.99"
  86. setprc(0,5)
  87. eject
  88.  
  89. && test miscellaneous conversions and indenting
  90.     // test comment change
  91. getlist={}
  92. getlist:={}
  93. anarry:={}
  94. clear screen
  95. ii=achoice(1,2,34,4,test,.t.,"",9)
  96. ii=asort(ff,1,acnt)
  97. ii=adir(skeleton,anarr)
  98. for ii=1 to 10
  99.   afill(aa[ii],0)
  100. next
  101. ii=0   // test for comment
  102. ? ii==jj   && test for double equal
  103. ? ii!=jj   && test for not equal
  104.   readmodal(getlist)
  105.   if(ii>10,11,123)
  106.   ii=if(ii>10,11,123)
  107.   ii=iif(ii>10,11,123)
  108.   if !(ii==jj) .and. !kk
  109.     ? ii
  110.   endif
  111.   line++
  112.   line--
  113.   ++line
  114.   --line
  115. line+=jj+2
  116. line-=jj*4
  117. xxx[5][10]++
  118. ? ii % jj      // test for conversion to mod function
  119. custnum="jkljlk"
  120. partnum="jkljlk"
  121. @ 5,0 say "this is a test of the multi-line combining for mxr()"+ ;
  122.   "jjjjj cjjjjjj j j j jj jj  j jj jj j"+ ;
  123.   "jjjjj cjjjjjj j j j jj jj  j jj jj j"
  124. @ 5,0 say "this is a test of the multi-line combining for "+ ;
  125.   "jjjjj cjjjjjj j j j jj jj  j jj jj j"+ ;
  126.   "jjjjj cjjjjjj j j j jj jj  j jj jj j" get partnum
  127. @ 6,0 get test pict "@!"
  128. read
  129. xxx[5][10]++
  130. use empinfo
  131. report form testform for .not. empty(emp_no) heading "Test Heading" to printer
  132. && convert by hand to:
  133. &&     devtopr()
  134. &&     frmrep("testform",".not. empty(emp_no)","Test Heading")
  135. &&     devtoscr()
  136.  
  137. alleeo[mfoffset+race][skill]++
  138.  
  139.  
  140. && test "@ prompt" and "menu to" conversion
  141.  
  142. procedure test1
  143. parameters one,two
  144.  
  145. local ii,jj,kk,arr[10],arr3[10][20],mm,zz,arr4[10,20]
  146. static tii,tarr[10],tzz,tarr3[10][20],tarr2[110,20]
  147. private ff,gg[10],hh[10][20][10]
  148.  
  149. ii=0
  150. jj=10
  151. @ 5,0 say "test pattern to check and see if it will show"+;
  152.   " additional lines in the FIX file"+ ;
  153.   " additional lines in the FIX file"
  154.  
  155. @ 5,0 prompt "one"
  156. set message to 18
  157. @ 5,col()+2 prompt "two" mess "at two"
  158. @ 7,10 prompt "three" mess "at three"
  159. menu to ii
  160. @ 5,0 say "test pattern" get tt valid !empty(tt)
  161. read
  162.  
  163. @ 5,0 prompt "one"
  164. @ 5,col()+2 prompt "two" mess "at two"
  165. @ 7,10 prompt "three" mess "at three"
  166. menu to ii
  167. @ 5,0 get tt valid !empty(tt)
  168. read
  169.  
  170.  
  171. function test2(p1,p2,p3, ;
  172.   p4,p5)
  173.  
  174. local ii,jj,kk,arr[10],arr3[10][20],mm,zz,arr4[10,20]
  175. static tii,tarr[10],tzz,tarr3[10][20],tarr2[110,20]
  176. private ff,gg[10],hh[10][20][10]
  177.  
  178. ii=0
  179. jj=10
  180. @ 5,0 prompt "one"
  181. @ 5,col()+2 prompt "two" mess "at two"
  182. @ 7,10 prompt "three" mess "at three"
  183. menu to ii
  184.  
  185.  
  186.  
  187.